home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 April / EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso / EARCD / comm / www / HTMLThor.lha / HTMLThor.thor < prev   
Text File  |  1996-10-01  |  7KB  |  244 lines
  1. /*
  2. **   Filename: HTMLThor.thor
  3. **
  4. **   $VER: v1.45 (09.30.96)
  5. **
  6. **   Author:  Troy E. Bouchard
  7. **
  8. **   EMail:   tbouchar@ptialaska.net
  9. **   Webpage: http://www.ptialaska.net/~tbouchar
  10. **
  11. **   See HTMLThor.guide for more info.
  12. */
  13.  
  14. /* Find our Thor Port and number! */
  15. p = Address() || ' ' || show('P',,)
  16.     ThorPort = pos('THOR.',p)
  17. if ThorPort > 0 then ThorPort = word(substr(p,ThorPort),1)
  18. else
  19. do
  20.    say "Can't seem to find the Thor port!"
  21.    exit 10
  22. End
  23.  
  24. /* Load the BBSRead library up! */
  25. if ~show('p', 'BBSREAD') then
  26. do
  27.    address command
  28.    "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  29.    "WaitForPort BBSREAD"
  30. End
  31.  
  32. /* change these to match your system! */
  33. TB_WWW       = 'A HREF="digest/'
  34. TB_EMail   = 'A HREF="mailto:'
  35. TB_MSGPATH = 'T:'
  36.  
  37. EXT = '.html'  /* change this to .htm if you need to. */
  38.  
  39. /* aint ARexx just great? */
  40. /* change these to your favorite language */
  41. /* Keep the order though! */
  42. TB_WDAYS = 'Monday Tuesday Wednesday Thursday Friday Saturday Sunday'
  43. TB_MONTH = 'January February March April May June July August September October November December'
  44.  
  45. MDF_DELETED      =  5     /* Message is deleted. */
  46. MDF_UNRECOVERABLE =  6     /* Message can not be undeleted. */
  47.  
  48. /* Remco; start */
  49. SIGNAL ON SYNTAX /* signal the SYNTAX procedure when a syntax error occurs */
  50. SIGNAL ON HALT     /* signal the HALT procedure when sys:rexxc/hi is run */
  51. /* Remco; end */
  52.  
  53. options results
  54.  
  55. Call GetPages
  56.  
  57. GetPages:
  58.    Address BBSREAD
  59.    'GETBBSLIST stem "'BBSLIST'"'
  60.    if(rc ~=0) then
  61.    do
  62.       Address(ThorPort)
  63.       'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  64.       call cleanup
  65.    End
  66.  
  67.    Address(ThorPort)
  68.    'REQUESTLIST instem "'BBSLIST'" outstem "'TB_SYSTEM'" title "Selection:" DRAGSELECT MULTISELECT SIZEGADGET'
  69.    if(rc ~= 0) then exit
  70.    do i=1 to TB_SYSTEM.COUNT
  71.       Address BBSREAD
  72.       'GETCONFLIST "'TB_SYSTEM.i'" CONFLIST'
  73.       if(rc ~= 0) then
  74.       do
  75.      Address(ThorPort)
  76.      'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  77.      call cleanup
  78.       End
  79.  
  80.       Address(ThorPort)
  81.       'REQUESTLIST instem "'CONFLIST'" title "Select conference on ' || TB_SYSTEM.i || ":" ||'" SIZEGADGET'
  82.       if(rc ~= 0) then TB_CONFNAME = ""
  83.       else TB_CONFNAME = result
  84.  
  85.       MyConf = Translate(TB_CONFNAME,," ","_")
  86.  
  87. /* Main HTML file */
  88.       call open(out, TB_MSGPATH||MyConf||EXT, w)
  89.       call writeln(out, "<HTML><HEAD><TITLE>"MyConf||"</TITLE></HEAD>")
  90.       call writeln(out, "<BODY><HR><CENTER><H2>"MyConf"</H2><HR>")
  91.       call close(out)
  92.  
  93.       Address BBSREAD
  94.       'GETCONFDATA BBSName "'TB_SYSTEM.i'" ConfName "'TB_CONFNAME'" Stem CDATA'
  95.       if(rc ~= 0) then
  96.       do
  97.      Address(ThorPort)
  98.      'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  99.      call cleanup
  100.       End
  101.  
  102.       Address(ThorPort)
  103.       'OPENPROGRESS TITLE " HTMLThor v1.45" PT "Getting Pages..." AT "_Abort" PCW 30'
  104.       if(rc ~= 0) then
  105.       do
  106.      'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_OK"'
  107.      call cleanup
  108.       end
  109.       else win = result
  110.  
  111.       msgnumber = 0
  112.       do j = CDATA.FIRSTMSG to CDATA.LASTMSG
  113.      Drop MsgData.
  114.      Drop HeaderInfo.
  115.      Drop TextInfo.
  116.  
  117.      Address BBSREAD
  118.      'READBRMESSAGE "'TB_SYSTEM.i'" "'TB_CONFNAME'" MSGNR "'j'" DataStem "'MsgData'"'
  119.      if(rc ~= 0) then
  120.      do
  121.         Address(ThorPort)
  122.         'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  123.         call cleanup
  124.      end
  125.  
  126.      if (bittst(MsgData.FLAGS,MDF_DELETED) = 0 & bittst(MsgData.FLAGS, MDF_UNRECOVERABLE) = 0) then
  127.      do
  128.         msgnumber = msgnumber + 1
  129.         Address(ThorPort)
  130.         msgtext = 'Saving Page to: 'TB_MSGPATH||MyConf||msgnumber||EXT
  131.         'UPDATEPROGRESS REQ "'win'" TOTAL "'CDATA.NUMMESSAGES'" CURRENT "'msgnumber'" PT "'msgtext'"'
  132.         if(rc ~= 0) then do
  133.           call cleanup
  134.         end
  135.  
  136.         Address BBSREAD
  137.         'READBRMESSAGE "'TB_SYSTEM.i'" "'TB_CONFNAME'" MSGNR "'j'" TextStem "'TextInfo'" HeadStem "'HeaderInfo'"'
  138.         if(rc ~= 0) then
  139.         do
  140.            Address(ThorPort)
  141.            'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  142.            call cleanup
  143.         end
  144.  
  145.         'AMIGA2DATE "'HeaderInfo.CREATIONDATE'" Stem "'Time'"'
  146.         if(rc ~= 0) then
  147.         do
  148.         NewTime = value('HeaderInfo.CREATIONDATETXT')
  149.         Say ''
  150.         Say 'OH NO!  CREATIONDATE IS SET TO TEXT!'
  151.         Say NewTime
  152.         Say 'Delete Message nr: 'j' and try again'
  153.         call Cleanup
  154.         end
  155.  
  156.         if(Time.WDAY == '0') then
  157.            WKDays = 'Sunday'
  158.         else
  159.            WKDays = word(TB_WDAYS, Time.WDAY)
  160.            MODays = word(TB_MONTH, Time.MONTH)
  161.  
  162.         if symbol('HeaderInfo.FROMADDR') = "VAR" then
  163.            Addr = '<'TB_EMail || value('HeaderInfo.FROMADDR') || '">'
  164.  
  165.         if symbol('HeaderInfo.FROMNAME') = "VAR" then
  166.            Nom = value('HeaderInfo.FROMNAME') || '</A>'
  167.  
  168.         if symbol('HeaderInfo.SUBJECT') = "VAR" then
  169.            Subj = value('HeaderInfo.SUBJECT')
  170.  
  171. /* the middle part of the main html */
  172.         call open(out, TB_MSGPATH||MyConf||EXT, a)
  173.         call writeln(out,'<B>From:</B>'Addr||Nom'<BR><B>Subject:</B><'TB_WWW||MyConf||msgnumber||EXT'">'Subj||'.'||'</A><HR>')
  174.         call close(out)
  175.  
  176. /* the separate parts of the message for the #?.(html|htm) */
  177.         call open(out, TB_MSGPATH || MyConf || msgnumber || EXT, w)
  178.         call writeln(out, '<HTML><HEAD><TITLE>'MyConf||' - 'Subj||'</TITLE></HEAD>')
  179.         call writeln(out, '<BODY><H2><B><CENTER>'MyConf||'</H2>')
  180.         call writeln(out, 'Message posted on:<BR>'WKDays' 'MODays' 'Time.MDAY', 'Time.YEAR'</B>')
  181.         call writeln(out, '<HR><B>From:</B>'Addr||Nom' ('HeaderInfo.FROMADDR')<BR><B>Subject:</B> 'Subj||'</CENTER>')
  182.  
  183.         call SelectMSG
  184.         call close(out)
  185.  
  186.         cnt = value('TextInfo.TEXT.COUNT')
  187.  
  188.         call open(out, TB_MSGPATH||MyConf||msgnumber||EXT, a)
  189.         call writeln(out, '<HR><H4>')
  190.  
  191.         if(cnt = 0) then call writeln(out,'No Text</H4><BR>')
  192.         else do
  193.            do n = 1 to cnt
  194.           call writeln(out, value('TextInfo.TEXT.n')'<BR>')
  195.            end
  196.         end
  197.  
  198.         call writeln(out,'</H4>')
  199.  
  200.         call SelectMSG
  201.         call writeln(out,'<HR><CENTER><B>Output created by HTMLThor v1.45<BR>')
  202.         call writeln(out,'Written by: Troy E. Bouchard, © 1996</CENTER></B>')
  203.         call writeln(out,'<HR></BODY></HTML>')
  204.         call close(out)
  205.      end
  206.       end
  207.  
  208. /* bottom of main page */
  209.       call open(out, TB_MSGPATH||MyConf||EXT, a)
  210.       call writeln(out,'<B>Output created by HTMLThor v1.45<BR>')
  211.       call writeln(out,'Written by: Troy E. Bouchard, © 1996</B>')
  212.       call writeln(out,"<HR></BODY></HTML></CENTER>")
  213.       call close(out)
  214.    end
  215.  
  216.    Address(ThorPort)
  217.    'REQUESTNOTIFY TEXT "    We Are Done!\nHTML Files Copied!" BT "_Cool!"'
  218.    call cleanup
  219.  
  220. SelectMSG:
  221.    NextMSG = msgnumber + 1
  222.    PrevMSG = msgnumber - 1
  223.  
  224.    SELECT
  225.       When PrevMSG = 0 then call writeln(out,'<HR><CENTER>| <A HREF="'MyConf||CDATA.NUMMESSAGES||EXT'">Last Message</A> | <A HREF="'MyConf||NextMSG||EXT'">Next Message</A> |</CENTER>')
  226.       When NextMSG > CDATA.NUMMESSAGES then call writeln(out,'<HR><CENTER> | <A HREF="'MyConf||PrevMSG||EXT'">Previous Msg</A> | <A HREF="'MyConf||'1'||EXT'">First Message</A> |</CENTER>')
  227.       OTHERWISE call writeln(out, '<HR><CENTER>| <A HREF="'MyConf||PrevMSG||EXT'">Previous Message</A> | <A HREF="'MyConf||NextMSG||EXT'">Next Message</A> |</CENTER>')
  228.    End
  229. Return
  230.  
  231. /* Remco Start */
  232. SYNTAX:
  233.   SAY 'SYNTAX ERROR'
  234.   SAY 'Error 'rc' in line 'sigl': 'errortext(rc)
  235. HALT:
  236. cleanup:
  237.  IF (win ~= 0) & SYMBOL('win') = 'VAR' THEN DO
  238.    ADDRESS(thorport)
  239.    'CLOSEPROGRESS REQ' win
  240.  END
  241. EXIT
  242. /* Remco End */
  243.  
  244.